perm filename M1.FRT[M11,LCS] blob
sn#398786 filedate 1978-11-24 generic text, type T, neo UTF8
CPASS3 PASS 3 MAIN PROGRAM
C *** MUSIC V ***
INTEGER PEAK
DOUBLE PRECISION JFLNM,JTRNS,JBLA
DIMENSION T(50),TI(50),ITI(50)
COMMON I(7500) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,NRSOR,IPEAK
DATA JTRNS/'TRNS'/,JBLA/' '/
CC******* DATA IIIRD/Z5EECE66D/
CC DATA IIIRD/ DATA IIIRD/976545367/
DATA I/7500*0/,I(4)/12800/
C**************
C INIALIZATION OF PIECE
C IIIRD - ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
I(7)=32767
I(7)=I(7)+1
CC I(7)=IIIRD
IP9=IP(9)
C****** SEE BLOCK DATA RE. SCALE FACTORS ********* IP(12)=2**8
PEAK=0
NRSOR=0
IPEAK=0
C IPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
CC******* NREAD = 3
CC******* NWRITE = 2
NREAD=21
C PDP DSK1=DEV.21
NWRITE=1
C PDP DSK=DEV.1
CC REWIND NREAD
CC REWIND NWRITE
TYPE 401
ACCEPT 501,JFLNM,IDSK
C TYPE <CR> TO GET DEFAULT FILE NAME (TRNS.DAT).
IF(JFLNM.EQ.JBLA)JFLNM=JTRNS
CALL OPEN(21,JFLNM,0,'RDO',,,'UNF')
IF(IDSK.NE.0)GO TO 601
C OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
CALL OPEN(23,'TEST',0,'NEW',,,'UNF')
GO TO 701
C IF IDSK=0, SAMPLES WILL BE WRITTEN ON DSK (TEST.SND)
CC IDSK=0
C I(4)=SRATE
C 0=12-BIT
C (4)NCHNSā1 OR 2
601 IDSK=-1
401 FORMAT(' TYPE FILE NAME'/)
501 FORMAT(A4,I)
C**** ABOVE FOR PDP10 IO ********
701 SCLFT=IP(12)
I(2)=IP(4)
MS1=IP(7)
MS3=MS1+(IP(8)*IP(9))-1
MS2=IP(8)
I(4)=IP(3)
MOUT=IP(10)
C INITIALIZATION OF SECTION
5 T(1)=0.0
DO 220 N1=MS1,MS3,MS2
C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
220 I(N1)=-1
DO 221N1=1,IP9
221 TI(N1)=90909.
C MAIN CARD READING LOOP
204 CALL DATA (NREAD)
CX TYPE 1204,P(1),T(1)
CX PAUSE 'CALL DATA'
IF(P(2)-T(1))200,200,244
200 IOP=P(1)
IF(IOP)201,201,202
201 CALLERROR(1)
GO TO 204
202 IF(IP(1)-IOP)201,203,203
1203 FORMAT(1X5I/)
1204 FORMAT(1X5F/)
CX203 TYPE 1203,IOP,MS1,MS2,MS3
CX TYPE 1204,SCLFT
203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP
11 IVAR=P(3)
IVARE=IVAR+I(1)-4
DO 297 N1=IVAR,IVARE
IVARP=N1-IVAR+4
297 I(N1)=P(IVARP)
GO TO 204
3 IGEN=P(3)
IF(IGEN.NE.1)GO TO 282
CCC **** ONLY GEN1,GEN2 IN THIS VERSION GO TO (281,282,283,284,285),IGEN
281 CALLGEN1
GO TO 204
282 IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
CALLGEN2
GO TO 204
CCC 283 CALLGEN3
CCC GO TO 204
CCC 284 CALLGEN4
CCC GO TO 204
CCC 285 CALLGEN5
CCC GO TO 204
4 IVAR=P(3)
IVARE=IVAR+I(1)-4
DO 296N1=IVAR,IVARE
IVARP=N1-IVAR+4
296 I(N1+100)=P(IVARP)*SCLFT
GO TO 204
6 CALL FROUT3(IDSK)
STOP
C ENTER NOTE TO BE PLAYED
1 DO 230N1=MS1,MS3,MS2
230 IF(I(N1).EQ.-1)GO TO 231
CALLERROR(2)
C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
CX TYPE 1230,IP(9)
GO TO 204
1230 FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
231 M1=N1
M2=N1+I(1)-1
M3=M2+1
M4=N1+IP(8)-1
DO 232N1=M1,M2
M5=N1-M1+1
232 I(N1)=P(M5)*SCLFT
I(M1 )=P(3)
DO 233N1=M3,M4
233 I(N1)=0
DO 235N1=1,IP9
IF(TI(N1)-90909.)235,234,235
234 TI(N1)=P(2)+P(4)
ITI(N1)=M1
GO TO 204
235 CONTINUE
CALLERROR(3)
GO TO 204
C DEFINE INSTRUMENT
2 M1=I(2)
M2=IP(5)+IFIX(P(3))
I(M2)=M1
218 CALL DATA (NREAD)
IF(I(1)-2)210,210,211
210 I(M1)=0
I(2)=M1+1
GO TO 204
211 I(M1)=P(3)
M3=I(1)
I(M1+1)=M1+M3-1
M1=M1+2
DO 217N1=4,M3
M5=P(N1)
IF(M5)212,213,213
212 IF(M5+100)300,301,301
300 I(M1)=-IP(2)+(M5+101)*IP(6)
GO TO 216
301 I(M1)=-IP(13)+(M5+1)*IP(14)
GO TO 216
213 IF(M5- 100 )214,214,215
214 I(M1)=M5
GO TO 216
215 I(M1)=M5+26262
CCC 215 I(M1)=M5+262144
C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
216 M1=M1+1
217 CONTINUE
GO TO 218
C PLAY TO ACTION TIME
244 T(2)=P(2)
250 TMIN=90909.
CX PAUSE 'LABEL 250'
IREST=1
DO 241N1=1,IP9
IF(TMIN-TI(N1))241,241,240
240 TMIN=TI(N1)
MNOTE=N1
241 CONTINUE
IF(90909.-TMIN)251,251,243
243 IF(TMIN-T(2))245,245,246
245 T(3)=TMIN
GO TO 260
246 T(3)=T(2)
GO TO 260
247 IF(T(1)-T(2))249,200,200
249 TI(MNOTE)=90909.
M2=ITI(MNOTE)
I(M2)=-1
GO TO 250
C SETUP REST
251 T(3)=T(2)
IREST=2
GO TO 260
C PLAY
260 ISAM=(T(3)-T(1))*FLOAT(I(4))+.5
T(1)=T(3)
IF(ISAM)247,247,266
266 IF(ISAM-IP(14))262,262,263
262 I(5)=ISAM
ISAM=0
GO TO 264
263 I(5)=IP(14)
ISAM=ISAM-IP(14)
264 IF(I(8))290,290,291
290 M3=MOUT+I(5)-1
MSAMP=I(5)
GO TO 292
291 M3=MOUT+(2*I(5))-1
MSAMP=2*I(5)
292 DO 267N1=MOUT,M3
267 I(N1)=0
GO TO (268,265),IREST
268 DO 270NS1=MS1,MS3,MS2
IF(I(NS1)+1)271,270,271
C GO THROUGH UNIT GENERATORS IN INSTRUMENT
271 I(3)=NS1
IGEN=IP(5)+I(NS1)
IGEN=I(IGEN)
272 I(6)=IGEN
CC***** IF(I(IGEN)-101)293,294,294
CC***** 293 CALLSAMGEN(I)
C**** ABOVE FOR MACHINE LANG. UNIT GENERATORS *******
CC***** GO TO 295
294 CALLFORSAM
295 IGEN=I(IGEN+1)
IF(I(IGEN))270,270,272
270 CONTINUE
265 CALL SAMOUT(IDSK ,MSAMP)
IF(ISAM)247,247,266
END